home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / jinx.lha / jinx.shell < prev    next >
Text File  |  1993-08-13  |  7KB  |  275 lines
  1. #! /local/bin/perl
  2.  
  3. # jinx.shell -- Copyright (c) 1990, Henk P. Penning.
  4. # You may distribute under the terms of the GNU General Public License
  5. # as specified in the README file that comes with the Jinx 2.1 kit.
  6.  
  7. do 'jinx.pl' || die "can't include jinx.pl\n" ;
  8.  
  9. sub mapFieldNames
  10.   { local(*fNames,*args) = @_ ;
  11.     local($res,$_,@res,@errors) ;
  12.  
  13.     &mkInvert(*fNames) ;
  14.  
  15.     for ( @args )
  16.       { if ( defined($fNames{$_}) )
  17.       { push(@res,$fNames{$_}+0) ; }
  18.     else
  19.       { push(@errors,"$_ is not a valid name") ; }
  20.       }
  21.     if ( $#errors >= 0 )
  22.       { return 0, @errors ; }
  23.     else
  24.       { return 1, @res ; }
  25.   }
  26.  
  27. sub JsortSh
  28.   { if ( $#_ < 0 )
  29.       { return 0, "Usage: Jsort <jinx-db> [ field ... ]\n" ; }
  30.  
  31.     local($db,@args) = @_ ;
  32.     local($res,@res,@errors) ;
  33.  
  34.     if ( -e "$db.dat" && ! -w "$db.dat" )
  35.       { return 0, "Jsort: cannot write $db.dat\n" ; }
  36.  
  37.     ($res,@errors) = &openDb($db,*descr,*data,*name,*pat) ;
  38.     if ( $res != 0 ) { return 0, @errors ; }
  39.  
  40.     ($res,@errors) = &mapFieldNames(*name,*args) ;
  41.     if ( $res == 0 ) { return 0, @errors ; } else { @args = @errors ; } 
  42.  
  43.     ($res,@errors) = &doSort(*data,*args) ;
  44.     if ( $res == 0 ) { return 0, @errors ; }
  45.  
  46.     return &putInfo(*data,$db,'dat') ;
  47.   }
  48.  
  49. sub Jsort
  50.   { if ( $#_ < 0 )
  51.       { die "Usage: Jsort <jinx-db> [ field ... ]\n" ; }
  52.     local($res,@errors) = &JsortSh ;
  53.     local($_) ;
  54.     for ( @errors ) { print STDERR "Jsort: $_\n" ; }
  55.     die "fatal error in Jsort\n" if $res == 0 ;
  56.   }
  57.  
  58. sub JprojectSh
  59.   { return 0, "Usage: Jproject <new> <old> field ...\n" if $#_ < 2 ; 
  60.  
  61.     local($new,$old,@args) = @_ ;
  62.     local($res,@res,@errors,@errors1,@errors2) ;
  63.  
  64.     local(@descr1,@data1,@name1,@pat1) ;
  65.  
  66.     ($res,@errors) = &openDb($old,*descr1,*data1,*name1,*pat1) ;
  67.     if ( $res != 0 ) { return 0, @errors ; }
  68.  
  69.     ($res,@errors) = &mapFieldNames(*name1,*args) ;
  70.     if ( $res == 0 ) { return 0, @errors ; } else { @args = @errors ; } 
  71.  
  72.     ($res,@errors) = &doProject(*descr1,*name1,*pat1,*data1,*args) ;
  73.     if ( $res == 0 ) { return 0, @errors ; }
  74.  
  75.     ($res,@errors1) = &putInfo(*descr1,$new,'des') ;
  76.     if ( $res == 0 ) { return 0, @errors1 ; }
  77.     ($res,@errors2) = &putInfo(*data1,$new,'dat') ;
  78.     if ( $res == 0 ) { return 0, @errors2 ; }
  79.     return 1, @errors1, @errors2 ;
  80.   }
  81.  
  82. sub Jproject
  83.   { die "Usage: Jproject <new> <old> field ...\n" if $#_ < 2 ; 
  84.     local(@args) = @_ ;
  85.     local($res,@errors,$_) ;
  86.  
  87.     ($res,@errors) = &JprojectSh(@args) ;
  88.     for ( @errors ) { print STDERR "Jproject: $_\n" ; }
  89.     die "fatal error in Jproject\n" if $res == 0 ;
  90.   }
  91.  
  92. sub JjoinSh
  93.   { return 0, "Usage: Jjoin <new> <old1> <old2>\n" if $#_ != 2 ; 
  94.  
  95.     local($new,$old1,$old2) = @_ ;
  96.  
  97.     local(@descr1,@data1,@name1,@pat1,@descr2,@data2,@name2,@pat2) ;
  98.     local(@errors,@errors1,@errors2) ;
  99.  
  100.     ($res,@errors) = &openDb($old1,*descr1,*data1,*name1,*pat1) ;
  101.     if ( $res != 0 ) { return 0, @errors ; }
  102.     ($res,@errors) = &openDb($old2,*descr2,*data2,*name2,*pat2) ;
  103.     if ( $res != 0 ) { return 0, @errors ; }
  104.  
  105.     ($res,@errors) = &doJoin(*descr1,*data1,*descr2,*data2,'A','A') ;
  106.     if ( $res == 0 ) { return 0, @errors ; }
  107.  
  108.     ($res,@errors1) = &putInfo(*descr1,$new,'des') ;
  109.     if ( $res == 0 ) { return 0, @errors1 ; }
  110.     ($res,@errors2) = &putInfo(*data1,$new,'dat') ;
  111.     if ( $res == 0 ) { return 0, @errors2 ; }
  112.     return 1, @errors1, @errors2 ;
  113.   }
  114.  
  115. sub Jjoin
  116.   { die "Usage: Jjoin <new> <old1> <old2>\n" if $#_ != 2 ; 
  117.     local(@args) = @_ ;
  118.     local($res,@errors,$_) ;
  119.  
  120.     ($res,@errors) = &JjoinSh(@args) ;
  121.     for ( @errors ) { print STDERR "Jjoin: $_\n" ; }
  122.     die "fatal error in Jjoin\n" if $res == 0 ;
  123.   }
  124.  
  125. sub JreportSh
  126.   { return 0, "Usage: Jreport <template> <db> [ OUT ]\n" if $#_ < 1 ; 
  127.  
  128.     local($template,$db,$outName) = @_ ;
  129.  
  130.     local(@descr,%name,@name,@pat,@data,$data,@errors,@template) ;
  131.     local($i,$splitpat,@tempres,@temp,$OUTFILE) ;
  132.  
  133.     return 0, "can't open $template" if ! open(TEMP,$template) ;
  134.     @template = <TEMP> ;
  135.     $template = join('',@template) ;
  136.  
  137.     ($res,@errors) = &openDb($db,*descr,*data,*name,*pat) ;
  138.     if ( $res != 0 ) { return 0, @errors ; }
  139.     &mkInvert(*name) ;
  140.  
  141.     if ( $outName )
  142.       { open(OUT,">$outName") || return 0, "can't write $outName" ;
  143.     $OUTFILE= 'OUT' ;
  144.       }
  145.     else
  146.       { $outName = 'STDOUT' ; 
  147.         $OUTFILE = 'STDOUT' ;
  148.       }
  149.  
  150.     $splitpat = '(:' . join(':|:',@name) . ':)' ;
  151.     $* = 1 ; @temp = split(/$splitpat/,$template) ; $* = 0 ;
  152.     @tempres = () ;
  153.     $i = '0' ;
  154.     for $temp ( @temp )
  155.       { if ( $temp =~ /$splitpat/ )
  156.       { $temp =~ /^:(.*):$/ ;
  157.         push(@tempres,'$record[' . $name{$1} . ']') ;
  158.       }
  159.     else
  160.       { push(@tempres,'$temp' . "[$i]") ; }
  161.     $i++ ;
  162.       }
  163.     eval 'sub tempres { return ' . join(' . ',@tempres) . ' ; }' ; 
  164.  
  165.     for $data ( @data )
  166.       { @record = split(/$;/,$data,$#name+1) ;
  167.     $record = &tempres ;
  168.     print $OUTFILE $record ; 
  169.       }
  170.  
  171.     close(OUT) if $outName ne 'STDOUT';
  172.     return 1, "report written to $outName" ;
  173.   }
  174.  
  175. sub Jreport
  176.   { die "Usage: Jreport <template> <db> [ OUT ]\n" if $#_ < 1 ; 
  177.     local(@args) = @_ ;
  178.     local($res,@errors,$_) ;
  179.  
  180.     ($res,@errors) = &JreportSh(@args) ;
  181.     for ( @errors ) { print STDERR "Jreport: $_\n" ; }
  182.     die "fatal error in Jreport\n" if $res == 0 ;
  183.   }
  184.  
  185. sub JlistSh
  186.   { local($header,$break,$width,$OPT,@errors,$curWidth) ;
  187.     while ( $#_ >= 0 && $_[0] =~ /^-/ )
  188.       { $OPT = shift ;
  189.     if ( $OPT eq '-h' )
  190.       { $header = 1 ; }
  191.     elsif ( $OPT =~ /^-w(\d*)/ )
  192.       { $break = 1  ;
  193.         $width = ($1) ? $1 : 80 ;
  194.       }
  195.     else
  196.       { push(@errors,"$0: Unknown option '$OPT'") ; }
  197.       }
  198.  
  199.     if ( $#errors >= 0 || $#_ < 0 )
  200.       { return 0, @errors, "Usage: Jlist [-w[width]] [-h] <db> [ OUT ]" ; }
  201.  
  202.     local($db,$outName) = @_ ;
  203.  
  204.     local(@descr,%name,@name,@pat,@data,$data,@errors) ;
  205.     local($i,@notNum,@maxlen,$formatH,$formatD,$OUTFILE) ;
  206.  
  207.     ($res,@errors) = &openDb($db,*descr,*data,*name,*pat) ;
  208.     if ( $res != 0 ) { return 0, @errors ; }
  209.     &mkInvert(*name) ;
  210.  
  211.     if ( $outName)
  212.       { open(OUT,">$outName") || return 0, "can't write $outName" ;
  213.     $OUTFILE = 'OUT' ;
  214.       }
  215.     else
  216.       { $outName = 'STDOUT' ;
  217.         $OUTFILE = 'STDOUT' ;
  218.       }
  219.  
  220.     for $data ( @data )
  221.       { @record = split(/$;/,$data,$#name+1) ;
  222.     $i = 0 ; 
  223.     for ( @record )
  224.       { $maxlen[$i] = length($_) if length($_) > $maxlen[$i] ;
  225.         $notNum[$i] |= /\D/ if ! $notNum[$i] ;
  226.         $i++ ;
  227.       }
  228.       }
  229.  
  230.     if ( $header )
  231.       { $i = 0 ;
  232.     for ( @name )
  233.       { $maxlen[$i] = length($_) if length($_) > $maxlen[$i] ; $i++ ; }
  234.       }
  235.  
  236.     $i = 0 ; $curWidth = 0 ;
  237.     for ( @maxlen )
  238.       { if ( $break && $curWidth+$_ > $width )
  239.       { $formatH .= "\n" ;
  240.         $formatD .= "\n" ;
  241.         $curWidth = 0 ;
  242.       }
  243.     $formatH .= '%-' . ($_+0) . 's ' ;
  244.     $formatD .= '%'  . ( $notNum[$i] ? '-' : '' ) . ($_+0) . 's ' ;
  245.     $curWidth += $_+1 ;
  246.     $i++ ;
  247.       }
  248.     chop $formatH ; $formatH .= "\n" ;
  249.     chop $formatD ; $formatD .= "\n" ;
  250.  
  251.     if ( $header )
  252.       { printf $OUTFILE $formatH, @name ;
  253.     print $OUTFILE "\n" ;
  254.       }
  255.  
  256.     for $data ( @data )
  257.       { @record = split(/$;/,$data,$#name+1) ;
  258.     printf $OUTFILE $formatD, @record ;
  259.       }
  260.  
  261.     close(OUT) if $outName ne 'STDOUT' ;
  262.     return 1, "list written to $outName" ;
  263.   }
  264.  
  265. sub Jlist
  266.   { local(@args) = @_ ;
  267.     local($res,@errors,$_) ;
  268.  
  269.     ($res,@errors) = &JlistSh(@args) ;
  270.     for ( @errors ) { print STDERR "Jlist: $_\n" ; }
  271.     die "fatal error in Jlist\n" if $res == 0 ;
  272.   }
  273.  
  274. 1 ;
  275.